home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1994 / MacHack 1994.toast / MacHack™94 / Talks & Papers / Timothy Knox / yerk 3.66 / Module source / Decompile < prev    next >
Text File  |  1994-06-24  |  18KB  |  590 lines
  1. \ Yerk Disassembler
  2. \  1/16/86  cdn Initial version
  3. \  1/20/86  cdn Handle named input parameters and local variables
  4. \  2/24/86  cdn Added detection of Immediate words
  5. \                Added RANGEOF
  6. \  6/01/86  cdn Added (++>), (EX>), (TRAP), (DEFER), (JMP), COMPILE
  7. \  6/02/86  cdn Added deClass, deObj, deModule, etc…
  8. \  8/11/86  cdn Added multiple cfa recognition
  9. \  8/25/86  cdn Added method decompilation
  10. \  6/29/87    rfl Added the first three cases to handle floats
  11. \ 12/17/87    rfl Fixed .num to show signs
  12. \  1/11/90    rfl Fixed ?isobj,?isclass,?ismod,?isvect,.32-bit etc. for protection
  13. \                  against invalid RAM
  14. \  3/14/90    rfl    nhash now wordcol; took out ?isobj since now in Class
  15. \ 10/03/90    rfl    added protection for lit numbers out of app range
  16. \ 10/26/90    rfl changed /module to |module so can decompile words with '/' in them
  17. \ 12/16/90    rfl    added offCol instead of old ordered-col
  18. \  3/29/91    rfl fixed slight bug setting 0 -> #p in decol
  19. \ 10/26/91    rfl    undid a reserve back to allot in name/hash
  20. \  2/25/92    rfl    fixed super/self problem with decompiling a class method
  21. \  5/14/93    rfl    now decompiles vect, value, and sysvec contents too.
  22. \  6/17/93    rfl    fixed another super/self problem when de' a method
  23. \  6/22/93    rfl added support for float named input and local vars
  24. \  7/16/93    rfl    after 3.64 release, redefined 'inapprange?' to use heapbot and top
  25. \  7/21/93    rfl    added inapprange? to 32-bit
  26. \ 12/29/93    rfl    no longer crashes on mcode
  27.  
  28. \ de' will decompile colon definitions and methods of classes; follow with a
  29. \ slash-module name to decompile module code.  Named stack parms and local vars
  30. \ are indicated by a curly bracket syntax like the one used to compile them,
  31. \ however their actual names are no longer known after compilation so symbolic
  32. \ names parmN & varN are shown.  Method selectors are also unavailable after
  33. \ compilation since they are hashed, so the common sequence: meth: obj
  34. \ decompiles as: ???: obj.  Methods bound to ivars within class definitions
  35. \ are shown by the offset of the ivar data within the object.  eg: ???: 12
  36. \ Anything completely unrecognized will display as ¿¿¿
  37. \
  38. \ "deflgs" bits:
  39. \ 0 - print absolute address of each item
  40. \ 1 - print relative address of each item
  41. \ 2 - print offset of each item
  42. \ 3 - display super class data
  43. \ 4 - display nested ivar stuctures
  44. \ 5 - display indexed data
  45.  
  46. :module deMod
  47.  
  48. 0 value tab
  49. : indent tab 4* out - 0 max spaces ;
  50.  
  51. : .bld  1 tFace ;    \ print in bold
  52. : .exp 64 tFace ;    \ print in expanded
  53. : .nor  0 tFace ;    \ revert to normal mode
  54. : .hash .bld ."   hash:" . .nor ;
  55.  
  56. \ : sign rot 0< IF 45 hold THEN ;
  57. \ ( val -- )
  58. : .num dup abs 0 <# #s sign #> type ;
  59.  
  60. 0 value start
  61. \ Print address and/or offset of datum
  62. : .addr { addr -- }
  63.     .bld
  64.     deflgs 01 and IF addr +base   .num ascii : emit THEN
  65.     deflgs 02 and IF addr         .num ascii : emit THEN
  66.     deflgs 04 and IF addr start - .num ascii : emit THEN
  67.     .nor ;
  68.  
  69. : NewL ?pause
  70.     CR dup .addr
  71.     0 -> out indent ;
  72.  
  73. : ?NewL
  74.     out tab 4* - 0> IF NewL THEN ;
  75.  
  76. \ ( addr -- addr' )  print "parmN" or "varN"
  77. : .p/v
  78.     dup @ >name 3+ c@ dup 48 - mp0 <    \ mp0 is a peek at deComp's "#p" var
  79.     IF ." parm" ELSE ." var" THEN
  80.     emit space  4+ ;
  81.  
  82. \ ( addr -- addr' )  print "parmN" or "varN"
  83. : .%p/v
  84.     dup    @ >name  4+ c@ dup 48 - mp0 <    \ mp0 is a peek at deComp's "#p" var
  85.     IF ." %parm" ELSE ." %var" THEN
  86.     emit space  4+ ;
  87.  
  88. 0 value nflgs
  89. \ ( pfa -- )  print name of definition and save name field flags
  90. : .nfa nfa dup id. c@ -> nflgs ;
  91.  
  92. :CLASS  wArray  <Super  Object  2 <Indexed
  93.  
  94.     :M  AT:        ?idx ^Elem  w@             ;M
  95.     :M  TO:        ?idx ^Elem  w!            ;M
  96.  
  97. ;CLASS
  98.  
  99. :CLASS wordCol  <Super wArray
  100.  
  101.     Int        Size    \ # elements in list
  102.  
  103.     \ ( -- curSize )  Return #elements currently in list
  104.     :M  SIZE:  Get: Size  ;M
  105.  
  106.     \ ( val -- )   Add value to end of list
  107.     :M  ADD:  Get: Size  limit  >=
  108.         classErr" 137  Get: size  To: Self
  109.         1 +: Size   ;M
  110.  
  111.     \ ( val -- ind t  OR f)  Find a value in an OC
  112.     :M  INDEXOF:  0 swap Get: Size  0
  113.         DO i  (^elem) w@
  114.             over = IF 2drop  i 1 1 leave THEN
  115.         LOOP  drop  ;M
  116.  
  117. ;CLASS
  118.  
  119. :CLASS OffArray <super wordCol
  120.  
  121.     var    pointer
  122.  
  123.   :M init: ( addr --) put: pointer ;M
  124.   :M at: ( ind -- addr) at: super get: pointer + ;M
  125.   :M add: ( addr --) get: pointer - add: super ;M
  126.  
  127. ;CLASS
  128.  
  129. 425 WordCol nHash
  130. 425 OffArray hName
  131. : name/hash here init: hName
  132.     new: loadFile
  133.     " name/hash" name: topFile
  134.     openReadOnly: topFile IF ." No name/hash table available" exit THEN
  135.     BEGIN
  136.         tib 128 expect: topFile 0=
  137.     WHILE
  138.         bytesRead: topFile 1-
  139.         tib over here >str255 here c@ >uc
  140.         here hash add: nHash
  141.         here add: hName
  142.         1+ allot
  143.     REPEAT
  144.     remove: loadFile
  145. ;
  146. name/hash
  147.  
  148. \ ( val -- )
  149. : .mName
  150.     indexOf: nhash
  151.     IF at: hName count type space
  152.     ELSE ." ???: " THEN ;
  153.  
  154. : inAppRange? ( addr -- addr b) dup heapBot heapTop within ;
  155.  
  156. \ ( pfa #parms -- )  Decompile cfas starting from pfa
  157. : deComp { #p \ ;? cf? -- }    \ #p number of parms, ;? end of defintion flag
  158.     0 -> ;?
  159.     1 ++> tab indent
  160.     BEGIN    ( addr )
  161.         dup @
  162.         CASE    ( addr cfa )
  163.         'c flit            OF  4+ dup print: float 10 +                ENDOF
  164.         'c killfargs    OF    ." KillFargs" 6 +                        ENDOF
  165.         'c !fp(ip)        OF  ." -> "  4+ dup w@ 8 - 4 / $ 30 + ." %parm" emit 2+    space ENDOF
  166.         'c +fp(ip)        OF  ." ++> " 4+ dup w@ 8 - 4 / $ 30 + ." %parm" emit 2+    space ENDOF
  167.         'c lit            OF    4+ dup @
  168.                             over 4+ @ dup 'c trap = swap 'c (fdos) = or
  169.                             IF ." $" .h
  170.                             ELSE inAppRange?
  171.                                 IF ?cfa
  172.                                     IF ." 'c " >name id.
  173.                                     ELSE dup cfa ?cfa
  174.                                         IF drop ." ' " nfa id.
  175.                                         ELSE drop .num space
  176.                                         THEN
  177.                                     THEN
  178.                                 ELSE .
  179.                                 THEN
  180.                             THEN 4+                                    ENDOF
  181.         'c wlit            OF    4+ dup w@
  182.                             over 2+ @ dup 'c trap = swap 'c (fdos) = or
  183.                             IF ." $" .h
  184.                             ELSE dup cfa inAppRange?
  185.                                 IF ?cfa
  186.                                     IF drop ." ' " nfa id.
  187.                                     ELSE drop .num space
  188.                                     THEN
  189.                                 ELSE .
  190.                                 THEN
  191.                             THEN 2+                                    ENDOF
  192.         'c wlitw        OF    4+ ." w" dup w@ . 2+                    ENDOF
  193.         'c (lits)        OF    4+ ?NewL dup w@ ." <[" dup . ." ]> 'cfas "
  194.                             swap 2+ swap 0
  195.                             DO dup @ >name id. 4+ LOOP                ENDOF
  196.         'c (trap)        OF    4+ ascii $ emit
  197.                             base >R hex
  198.                                 dup w@ . ." Trap " 2+
  199.                             R> -> base                                ENDOF
  200.         'c [trap]        OF        4+ ascii $ emit
  201.                             base >R hex
  202.                                 dup w@ . ." Trap " 12 +
  203.                             R> -> base                                ENDOF
  204.         'c (defer)        OF    4+ dup w@ .mName ." [ ] " 2+            ENDOF
  205.         'c (classerr")    OF    4+ ." ClassErr" ascii " emit
  206.                             dup w@ . 2+                                ENDOF
  207.         'c (.rAbort)    OF    4+ ." ?error"
  208.                             dup w@ . 2+                                ENDOF
  209.         'c (.rStr)        OF    4+ ." msg#"
  210.                             dup w@ . 2+                                ENDOF
  211.         'c (.tStr)        OF    4+ ." type#"
  212.                             dup w@ . 2+                                ENDOF
  213.         'c compile        OF    4+ ." Compile " dup @ >name id. 4+        ENDOF
  214.         'c branch        OF    4+ ." Branch:"  dup @ dup .
  215.                             over + .addr 4+        NewL                ENDOF
  216.         'c 0branch        OF    4+ ." 0Branch:" dup @ dup .
  217.                             over + .addr 4+        NewL                ENDOF
  218.         'c (do)            OF    8+ ?NewL ." DO "    1 ++> tab    NewL    ENDOF
  219.         'c (loop)        OF    8+ -1 ++> tab        ?NewL  ." LOOP "    ENDOF
  220.         'c (loop+)        OF    8+ -1 ++> tab        ?NewL ." +LOOP "    ENDOF
  221.         'c (of)            OF    8+ ." OF "                                ENDOF
  222.         'c (rof)        OF    8+ ." RANGEOF "                            ENDOF
  223.         'c (select)        OF    4+ ?NewL ." Select{" NewL
  224.                             @ dup dup dup @ - 4 / 1- 0
  225.                             DO    i . ." is{ " 4- dup @ #p deComp
  226.                                 ." }end"  NewL
  227.                             LOOP ." default{ "
  228.                             4- @ #p deComp
  229.                             ?NewL ." }Select" 4+ NewL                ENDOF
  230.         'c (.")            OF    4+ ascii . emit ascii " emit space
  231.                             count 2dup type ascii " emit space
  232.                             + align                                    ENDOF
  233.         'c (lit")        OF    4+ ascii " emit space
  234.                             count 2dup type ascii " emit space
  235.                             + align                                    ENDOF
  236.         'c (ab")        OF    4+ ." Abort" ascii " emit space
  237.                             count 2dup type ascii " emit space
  238.                             + align                                    ENDOF
  239.         'c (al")        OF    4+ ." Alert" ascii " emit space
  240.                             count 2dup type ascii " emit space
  241.                             + align                                    ENDOF
  242.         'c (disp)        OF    4+ ." Dispose> " dup @ 8- nfa id. 4+    ENDOF
  243.         'c (mdisp)        OF    4+ ." Dispose> " dup w@ dup #p <
  244.                             IF ." parm" ELSE ." var" THEN
  245.                             48 + emit space 2+                        ENDOF
  246.         'c (be)            OF    ." Become " 4+                            ENDOF
  247.         'c (semip)        OF    drop                    1 -> ;?            ENDOF
  248.         'c (jmp)        OF    4+ @ .exp ." ( Forward referenced )"
  249.                                  .nor                        NewL    ENDOF
  250.         'c ;s            OF    drop                    1 -> ;?            ENDOF
  251.         'c (;m)            OF    drop                    1 -> ;?            ENDOF
  252.         'c (;code)        OF    drop CR ." (;CODE) "    1 -> ;?            ENDOF
  253.         'c (,code)        OF    drop CR ." BUILD "        1 -> ;?            ENDOF
  254.         'c header        OF    10 + dup 2- w@ 4 / 0
  255.                             DO  NewL .exp i .num ." cfa: " .nor
  256.                                 NewL dup @ 10 + 0 deComp CR 4+
  257.                             LOOP drop                1 -> ;?            ENDOF
  258.         'c @fp0            OF  .%p/v                                    ENDOF
  259.         'c @fp1            OF  .%p/v                                    ENDOF
  260.         'c @fp2            OF  .%p/v                                    ENDOF
  261.         'c @fp3            OF  .%p/v                                    ENDOF
  262.         'c @fp4            OF  .%p/v                                    ENDOF
  263.         'c @fp5            OF  .%p/v                                    ENDOF
  264.         'c mp0            OF    .p/v                                    ENDOF
  265.         'c mp1            OF    .p/v                                    ENDOF
  266.         'c mp2            OF    .p/v                                    ENDOF
  267.         'c mp3            OF    .p/v                                    ENDOF
  268.         'c mp4            OF    .p/v                                    ENDOF
  269.         'c mp5            OF    .p/v                                    ENDOF
  270.         'c ms0            OF    ." -> " .p/v                            ENDOF
  271.         'c ms1            OF    ." -> " .p/v                            ENDOF
  272.         'c ms2            OF    ." -> " .p/v                            ENDOF
  273.         'c ms3            OF    ." -> " .p/v                            ENDOF
  274.         'c ms4            OF    ." -> " .p/v                            ENDOF
  275.         'c ms5            OF    ." -> " .p/v                            ENDOF
  276.         'c (++>)        OF    4+ dup w@ 8- 4 / dup #p < ." ++> "
  277.                             IF ." parm" ELSE ." var" THEN
  278.                             48 + emit space 2+                        ENDOF
  279.         'c (ex>)        OF    4+ dup w@ 8- 4 / dup #p < ." exec> "
  280.                             IF ." parm" ELSE ." var" THEN
  281.                             48 + emit space 2+                        ENDOF
  282.         \ OTHERWISE
  283.  
  284.             dup >body ?isObj    \ normal early bound method?
  285.             IF    drop    ( addr cfa )
  286.                 over 4+ @ @ ' m0cfa =
  287.                 IF    over 4+ @ 6 - w@ .mName >name id. 8+
  288.                     deflgs 07 and IF dup 4- @ 6 - w@ .hash THEN
  289.                 ELSE >name id. 4+ THEN
  290.  
  291.             ELSE drop    ( addr cfa )
  292.  
  293.                 dup @ ' m1cfa =        \ method bound to a private ivar?
  294.                 IF    10 - w@ .mName 4+
  295.                     dup w@ 65535 over =    \ check for self/super ref
  296.                     IF    drop dup 4- @ start <
  297.                         IF ." super" ELSE ." self" THEN
  298.                     ELSE .num THEN space 2+
  299.                     deflgs 07 and IF dup 6 - @ 10 - w@ .hash THEN
  300.  
  301.                 ELSE    ( addr cfa )
  302.  
  303.                     dup @ ' m0cfa =    \ method bound to a class
  304.                     IF    dup 6 - w@ .mName
  305.                         latest BEGIN 2dup < WHILE pfa lfa @ REPEAT id. drop
  306.                         4+
  307.  
  308.                     ELSE    ( addr cfa )
  309.                         ?cfa                    \ ultimately, this is the usual case
  310.                         IF >name dup id. n>count " INLINE" s=
  311.                             IF 4+ BEGIN dup w@ dup $ 49fa <>
  312.                                WHILE ascii $ emit .h 2+
  313.                                     out 60 > IF NewL THEN
  314.                                REPEAT 
  315.                                 drop 4+     
  316.                             THEN
  317.                         ELSE 1 -> cf? 9 1
  318.                             DO  cfa ?cfa    \ check for nth cfa
  319.                                 IF dup @ >R  valCode R =    vectCode R  = or
  320.                                             fvalCode R = or   svCode R> = or
  321.                                     IF i 1 = IF ." ++> " ELSE ." -> " THEN
  322.                                     ELSE 48 i+ emit 45 emit THEN
  323.                                     >name id. 0 -> cf? leave
  324.                                 THEN
  325.                             LOOP
  326.                             cf? IF drop ." ¿¿¿ " THEN    \ all decomp failed
  327.                         THEN
  328.                         4+
  329.                     THEN
  330.  
  331.                 THEN
  332.             THEN
  333.  
  334.             dup    \ for consumption by endcase
  335.  
  336.         ENDCASE
  337.  
  338.         deflgs 07 and    \ print address and/or offset?
  339.         IF
  340.             NewL    \ new line for every word
  341.         ELSE
  342.             out 60 > IF NewL THEN
  343.         THEN
  344.  
  345.     ;? UNTIL
  346.     nflgs $ 40 and IF ." Immediate" THEN
  347.     -1 ++> tab
  348. ;
  349.  
  350. 0 value floatpos
  351. : isFloatP/V ( pos  --) floatPos and IF ascii % emit THEN ;
  352.  
  353. \ ( pfa -- )  decompile a definition; may have named stack
  354. : deCol { myPfa \ amt #p -- }    \ #p number of parms
  355.     0 -> #p
  356.     myPfa c@                        \ Does definition has named stack or local vars
  357.     IF    ." { "
  358.         myPfa c@ -> amt                \ get the total number of parms and vars
  359.         myPfa 1+ c@ -> floatPos        \ get position of any floats
  360.         amt $ F and -> #p            \ look at parms first
  361.         #p 0 DO i 1+ isFloatP/V ." parm" 48 i+ emit space LOOP
  362.         amt 4 >> -dup
  363.         IF ascii \ emit space 0 DO 1 #p i+ << isFloatP/V ." var" 48 #p + i+ emit space LOOP THEN
  364.         ." -- }" myPfa 2+ -> myPfa
  365.     THEN
  366.     NewL myPfa #p deComp ;
  367.  
  368. : NxtL ?pause
  369.     CR 0 -> out indent ;
  370.  
  371. \ ( pfa -- )  decompile a class definition
  372. : deClass { ^class \ k -- } CR
  373.     0 -> k    1 -> tab
  374.     ^class mfa @    \ get starting addresses of method
  375.     BEGIN dup ^class >
  376.     WHILE 1 ++> k dup 2+ @
  377.     REPEAT drop
  378.     ." :CLASS " ^class nfa id.
  379.     ."  <Super " ^class 22 + @ nfa id.
  380.     ^class 20 + w@ -dup IF . ." <Indexed" THEN CR
  381.     ^class 18 + w@ NxtL .exp ." (" . ." Bytes )" .nor CR
  382.     k 0 DO
  383.         NewL ." :M  " dup w@ .mName 10 + dup @
  384.         over 4+ = IF drop ." is an MCode definition" ELSE 4+ deCol THEN
  385.         NewL ." ;M" CR
  386.     LOOP
  387.     CR ." ;CLASS"
  388. ;
  389.  
  390. 0 value odata
  391. : .) ascii ) emit ;
  392. : .( .addr ascii ( emit ;
  393.  
  394. : .32-bit
  395.     dup . inAppRange?
  396.     IF ?cfa
  397.         IF >name id. ELSE drop THEN
  398.     ELSE drop
  399.     THEN ;
  400.  
  401. \ ( length -- )  display a fundamental datum from the object
  402. : .odata { w -- }
  403.     odata .(
  404.     w CASE
  405.         1 OF odata c@ .       ENDOF
  406.         2 OF odata w@ .       ENDOF
  407.         4 OF odata  @ .32-bit ENDOF
  408.     \ OTHERWISE
  409.     w . ." Bytes "    \ if not 1, 2 or 3; just tell how many bytes there are
  410.     ENDCASE
  411.     .)
  412.     w ++> odata
  413. ;
  414.  
  415. \ display indexed data cells with their indices
  416. : .idata { \ width -- }
  417.     odata w@ -> width 4 ++> odata    \ get width and skip indexed header
  418.     odata 2- w@ 0
  419.     DO    NxtL
  420.         i . width .odata            \ print the contents of each element
  421.     LOOP
  422. ;
  423.  
  424. Forward .struct
  425.  
  426. \ display contents of ivar
  427. : .ivars { lastNFA 1stNFA dlen \ inc -- }
  428.     lastNFA 12 + 1stNFA
  429.     DO    12 -> inc            \ usual length of an ivar
  430.         NxtL
  431.         i 6 + @                \ get ivars class pointer
  432.         dup ' Object =
  433.         IF    ." DATA " drop     \ This ivar is DATA
  434.             i lastNFA =        \ If last ivar, can't subtract from next ivar
  435.             IF dlen            \ computes # bytes
  436.             ELSE i 22 + w@ THEN
  437.                  i 10 + w@ - .odata
  438.         ELSE
  439.             dup nfa     id.                \ This ivar may be nested
  440.             dup @width                     \ indexed?
  441.             dup IF 14 -> inc
  442.                    4 ++> odata THEN        \ (get past indexed overhead)
  443.             over ifa @ 3 pick 26 + > or    \ nest?
  444.             deflgs 16 and lAnd            \ supposed to be displaying nested?
  445.             IF 1 ++> tab .struct -1 ++> tab
  446.             ELSE dfa w@ .odata THEN
  447.         THEN
  448.     inc +LOOP
  449. ;
  450.  
  451. 0 value snest
  452.  
  453. \ ( ^class -- )  print ivar data & indexed data (recursive from .ivars & self)
  454. :f .struct 
  455.     1 ++> snest
  456.     dup dfa w@            \ total length of object data
  457.     over sfa @ dfa w@    \ length of super class data
  458.     tab 0= over lAnd deflgs 08 and lAnd
  459.     IF  3 pick dup sfa @ dup nfa CR ." --" id. CR    \ display super data
  460.         .struct              nfa CR ." ==" id. CR
  461.     ELSE dup ++> odata THEN        \ skip super data
  462.     - -dup                \ total data minus super data
  463.     IF over ifa @                    \ pointer to last ivar
  464.         3 pick 26 +                    \ pointer to first ivar
  465.         rot .ivars                    \ print ivar data
  466.     ELSE tab 0= IF .exp ." ( No ivars )" .nor CR THEN THEN
  467.     @width                            \ print indexed data if any
  468.     IF deflgs 32 and snest 0= lAnd
  469.         IF    NxtL .exp ." --Indexed Data--" .nor
  470.             .idata
  471.         THEN
  472.     THEN
  473.     -1 ++> snest 
  474. ;f
  475.  
  476. \ ( pfa -- )  display the data of an object
  477. : deObj CR
  478.     dup here >
  479.     IF ." HEAP-OBJECT "
  480.     ELSE dup nfa id. THEN        \ otherwise print object name
  481.     dup -> odata                \ set start of data
  482.     .exp ." is an Object of Class: " .nor
  483.     cfa @ dup nfa id.            \ print superclass name
  484.      -1 -> snest  0 -> tab
  485.     .struct                        \ print ivar data & indexed data
  486. ;
  487.  
  488. \ ( pfa -- )  decompile a module definition
  489. : deModule { \ #imps -- }
  490.     ." From " dup nfa id. ." Import{ "
  491.     dup 16 + w@ -> #imps 12 + @
  492.     #imps 1- 0 DO        \ gather export words
  493.         dup pfa lfa @
  494.     LOOP
  495.     #imps 0 DO            \ print export word names
  496.         id.
  497.     LOOP
  498.     ." }"
  499. ;
  500.  
  501. 0 constant con
  502. 0 variable vare
  503.  
  504. \ ( pfa -- pfa bool )
  505. : ?isMod modCode over cfa (@) drop = ;
  506. ' does> 20 + constant doesCode
  507.  
  508. \ ( pfa -- )  setup for one of the decompilers: Colon, Class, Object, etc…
  509. : (de) ?pause
  510.     dup -> start    0 -> nflgs    0 -> tab
  511.     dup cfa @ over = IF nfa id. .exp ." is a Code word" .nor CR exit THEN
  512.     ?isObj   IF deObj CR exit THEN
  513.     ?isClass IF deClass CR exit THEN
  514.     ?isMod   IF deModule CR exit THEN
  515.     dup cfa @    ( pfa code )
  516.     dup colCode = over ' colP = or
  517.     IF drop CR ." : " dup .nfa deCol CR ." ; " CR exit THEN
  518.  
  519.     CASE
  520.     over .nfa .exp    ( pfa code )
  521.  
  522.     valCode   OF .bld ." is a Value " .nor 8+ dup .( @ dup .32-bit .) cr
  523.                     ?isobj IF (de) ELSE drop THEN             ENDOF
  524.     fvalCode  OF ." is an fValue" .nor drop                  ENDOF
  525.     impCFA    OF ." is an Import word " .nor dup .( space @ >name id. .)
  526.                  nflgs $ 40 and IF CR ." Immediate" THEN    ENDOF
  527.     'code con OF ." is a Constant " .nor dup .( @ .32-bit .) ENDOF
  528.     'code vare OF ." is a Variable " .nor dup .( @ .32-bit .) ENDOF
  529.     vectCode  OF .bld ." is a Vect " .nor 8+ dup .( @ -dup IF 4+ dup nfa space id. .) cr (de)
  530.                                     ELSE 0 . .) THEN        ENDOF
  531.     svCode    OF ." is a sysVect " .nor 8+ dup 4+
  532.                  begin-dp @ rot @ + dup @ 0= IF drop dup THEN
  533.                  dup .( @ 4+ dup nfa space id. ." ) … default "
  534.                  swap dup .( @ >name space id. .)    cr (de)            ENDOF
  535.     doesCode  OF @ latest BEGIN 2dup < WHILE pfa lfa @ REPEAT
  536.                 ." is a " id. ." definition" .nor drop        ENDOF
  537.  
  538.     \ OTHERWISE    ( pfa code )
  539.  
  540.         ' (dodo) over 2+ @ =
  541.         IF    0 >R latest BEGIN 2dup < WHILE R> drop dup >R pfa lfa @ REPEAT
  542.             ." is a " R> id. ." definition" .nor 2drop
  543.         ELSE
  544.             dup 4- @ over =
  545.             IF     ." is an alias of " .nor nfa id.
  546.             ELSE ." is a MYSTERY" .nor drop THEN
  547.         THEN
  548.  
  549.     ENDCASE
  550.     CR
  551. ;
  552.  
  553. \ ( str255 chr -- offs t OR f )
  554. : charOf { adr chr -- }
  555.     0    \ bool
  556.     adr c@ 1+ 1
  557.     DO
  558.         adr i+ c@ chr = IF drop i 1- 1 leave THEN
  559.     LOOP
  560. ;
  561.  
  562. \ ( str -- nfa )  lookup module vocabulary if specified; else main dictionary
  563. : dvoc { str -- }
  564.     str ascii | charOf
  565.     IF    str over 1+ over c@ over - str rot + c! c!    \ double string
  566.         str count + latest (find) 0= Abort" not found" drop
  567.         ?isMod 0= Abort" not a module"
  568.         dup cfa execute        \ get module into memory
  569.         8+ @ $ ffffff and
  570.            @ $ ffffff and    \ get nfa of last word in module
  571.     ELSE latest THEN ;
  572.  
  573. \ decompile any yerk word or method
  574. \ de' word[|module]
  575. \ de' meth: class[|module]
  576. : de'
  577.     @word dup c@ over + c@ ascii : =
  578.     IF    dup count str255 drop hash        \ method of a class
  579.         @word dup
  580.         dvoc (find) 0= Abort" not found" drop
  581.         ?isClass 0= Abort" not a class"
  582.         dup -> start (findm) ." :M  " buf255 count type 4+ deCol
  583.         CR ." ;M" CR
  584.     ELSE                                \ normal word
  585.         dup dvoc (find) 0= Abort" not found" drop
  586.         (de)
  587.     THEN ;
  588.  
  589. ;Module
  590.